home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / share.arc / SHARWARE.BAS next >
Encoding:
BASIC Source File  |  1988-01-23  |  27.8 KB  |  725 lines
  1. '┌───────────────────────────────────────────────────────────────────────┐
  2. '│           SHARWARE is a DataBase program for keeping track of         │
  3. '│        program registrations. It was written for a few reasons:       │
  4. '│                                                                       │
  5. '│         1) I was asked to write it for a few shareware authors        │
  6. '│          2) It serves as an example of the QBTOOLS/2 routines         │
  7. '│       3) I wanted to see what I could write in 2 hours (usefully)     │
  8. '│      4) I needed an example for the QBTOOLS/2 manual, this is it.     │
  9. '│                                                                       │
  10. '│          Everything in this program bears my / our copyright.         │
  11. '│    All of the routines are QBTOOLS/2 routines. These are only a few   │
  12. '│                     of the routines in the package.                   │
  13. '│                                                                       │
  14. '│                       QBTOOLS/2 is available from                     │
  15. '│                                                                       │
  16. '│                     Project X Software Development                    │
  17. '│                        222 Church Street Ste 5g                       │
  18. '│                       Philadelphia, PA 19106-2251                     │
  19. '│                                                                       │
  20. '│                           Voice: 215-922-2557                         │
  21. '│                           Data: 215-627-3910                          │
  22. '│                                                                       │
  23. '│        (c) Copyright Roy Barrow, Project X Software Development       │
  24. '└───────────────────────────────────────────────────────────────────────┘
  25.  
  26.    DECLARE FUNCTION DBValidate% (a%, b%)     '  Input options based upon Up
  27.                                              '  Down Arrow, or Page Down
  28.    DECLARE SUB SoftDB ()                     '  Startup Screen. SoftDB was
  29.                                              '  created with the Object
  30.                                              '  Screen Generator.
  31.  
  32. '$INCLUDE: 'qbtools2.inc'                    '  STANDARD Routine Definitions
  33. '$INCLUDE: 'qbtbtree.inc'                    '  BTREE Definitions
  34.  
  35.    OPTION BASE 0
  36.    DEFINT A-Z
  37.  
  38.    TYPE Customer                             '  Declare Customer Type
  39.       USED AS STRING * 1
  40.       FirstName AS STRING * 20
  41.       LastName AS STRING * 20
  42.       Title AS STRING * 20
  43.       Telephone AS STRING * 20
  44.       Address1 AS STRING * 30
  45.       Address2 AS STRING * 30
  46.       City AS STRING * 20
  47.       State AS STRING * 20
  48.       ZipCode AS STRING * 20
  49.       Country AS STRING * 20
  50.       Product AS STRING * 30
  51.       Version AS STRING * 20
  52.       DatePurch AS STRING * 8
  53.       Dealer AS STRING * 30
  54.       Comments AS STRING * 315
  55.    END TYPE
  56.  
  57.    DIM Cust AS Customer                      '  Create variables of Cust Type
  58.    DIM TestCust AS Customer
  59.  
  60.    DIM bx AS KeySelection                    '  Create KeySelectionBox Type
  61.  
  62.    DIM Choice$(6), Delop$(4)                 '  Scroll Box & Message Values
  63.    DIM Ok%(50)
  64.    DIM Cmnt$(15)                             '  Comments on Customer
  65.  
  66.    Choice$(1) = "Insert a new customer"
  67.    Choice$(2) = "Amend an existing customer"
  68.    Choice$(3) = "Delete (remove) a customer"
  69.    Choice$(4) = "Browse through customers"
  70.    Choice$(5) = "QUIT Program"
  71.    Choice$(6) = "Debugging .... delete files"   '  Only for DEBUGGING
  72.  
  73.    Mw% = 0                                   '  Maximum Width (So Far)
  74.    FOR j% = 1 TO 6
  75.       Mw% = Maximum%(LEN(Choice$(j%)), Mw%)  '  New Maximum
  76.    NEXT j%
  77.  
  78.    f1$ = "SOFTDATB.DAT"                      '  Software Registration DataBase
  79.    f2$ = "SOFTDAT1"                          '  Index 1  -  First Name
  80.    f3$ = "SOFTDAT2"                          '  Index 2  -  Last Name
  81.  
  82.    IF FileExists%(f1$) = 0 THEN              '  If it is NOT There then ...
  83.       IxNum1% = FREEFILE                     '     Get Free File Number
  84.       IndexCreate IxNum1%, f2$, 20           '     Create a FirstName INDEX
  85.  
  86.       IxNum2% = FREEFILE                     '     Get Free File number
  87.       IndexCreate IxNum2%, f3$, 20           '     Create a LastName INDEX
  88.  
  89.    END IF
  90.  
  91.    IxNum1% = FREEFILE                              '  Get free File Number
  92.    IndexOpen IxNum1%, f2$, Xnm$(), Xk$(), Xh%()    '  Open the Index
  93.  
  94.    IxNum2% = FREEFILE                              '  Get free File Number
  95.    IndexOpen IxNum2%, f3$, Xnm$(), Xk$(), Xh%()    '  Open the Index
  96.  
  97.    DatFile% = FREEFILE                             '  Get free file Number
  98.    OPEN f1$ FOR RANDOM AS DatFile% LEN = LEN(Cust) '  Open the data file
  99.  
  100.    DO
  101.       LOCATE 1, 1                                  '  Go to top of screen
  102.                                                    '  (Problem in QB4)
  103.       SoftDB                                       '  Display the input frame (OSG type)
  104.      
  105.       rv% = 1                                      '  Choice is initially 1
  106.       ScrollBox Choice$(), Mw%, 5, 30, 7, 7, 7, 0, 7, 0, 1, 5, Ok%(), rv%, rst$, GlbErr%
  107.                                                    '  Get the option
  108.  
  109.       SELECT CASE rv%                              '  Select on choice
  110.          CASE 1                                    '  Insert a new customer
  111.             GOSUB InitCust                         '  Init Customer Data
  112.             GOSUB CustDetails                      '  Get the details,
  113.                                                    '  and write to disk
  114.  
  115.          CASE 2                                    '  Amend an existing customer
  116.  
  117.             Toggle% = 0                            '  Search flag,
  118.                                                    '  For First or Last name
  119.             DO
  120.                bx.Row = 5                          '  Key Select Box values
  121.                bx.Col = 25
  122.                bx.Lin = 10
  123.                bx.Exi = 1
  124.                bx.Init1 = "Type initial search key for the customer"
  125.                bx.Init2 = "An exact match is not needed."
  126.                bx.KeyLen = 20
  127.  
  128.                IF Toggle% = 0 THEN                 '  Search on ?
  129.                   bx.o1 = "F1 - Switch to first name search"
  130.                   Ix% = IxNum1%                    '  Pass Index Number
  131.                ELSE
  132.                   bx.o1 = "F1 - Switch to last name search"
  133.                   Ix% = IxNum2%                    '  Pass Index Number
  134.                END IF
  135.  
  136.                bx.Echoice = 0                      '  What was selected
  137.                bx.Btype = 1                        '  Border type
  138.                                                    '  Same as DrawBox values
  139.                bx.Nf = 7                           '  Normal Foreground
  140.                bx.Nb = 0                           '  Normal Background
  141.                bx.Sf = 0                           '  Selected Foreground
  142.                bx.Sb = 7                           '  Selected Background
  143.                bx.Ff = 7                           '  Frame Foreground
  144.                bx.Fb = 0                           '  Frame Background
  145.  
  146.                KeySelectBox bx, Opt$, Ix%, Ky$, Mr%, Xnm$(), Xk$(), Xh%(), sc%
  147.  
  148.                                                    '  Get a key, and values
  149.  
  150.                IF bx.Echoice = -1 THEN             '  INDEX IS Empty
  151.  
  152.                   Delop$(1) = "No changing available! There are no"
  153.                   Delop$(2) = "items in the database to amend!"
  154.                   Delop$(3) = ""
  155.                   Delop$(4) = "Press any key to continue"
  156.  
  157.                   Message Delop$(), 4, 3, 7, 0, 7, 0  '  DIsplay Message &
  158.                                                       '  wait for a RETURN
  159.                   EXIT DO
  160.  
  161.                END IF
  162.  
  163.                IF sc% > 0 AND Mr% > 0 THEN            '  If the Record EXISTS
  164.  
  165.                   IF bx.Echoice = 1 THEN              '  If F1 was chosen
  166.                      Toggle% = 1 - Toggle%            '  Toggle to other index
  167.                   ELSE
  168.                      GET #DatFile%, Mr%, Cust         '  Get the record
  169.                      GOSUB DisplayCust                '  Display the details
  170.                      TempFirst$ = Cust.FirstName      '  Make copies of Keys
  171.                      TempLast$ = Cust.LastName
  172.                      GOSUB CustDetails                '  Get changes and then
  173.                                                       '  Write details away
  174.                      EXIT DO
  175.                   END IF
  176.                ELSE                                   '  Any (spurious) option
  177.                   EXIT DO                             '  just ignore & exit
  178.                END IF
  179.             LOOP
  180.  
  181.          CASE 3                                       '  Delete (remove) a customer
  182.             Toggle% = 0                               '  Toggle Search
  183.             DO
  184.                bx.Row = 5                             '  KeySelectBox values
  185.                bx.Col = 25
  186.                bx.Lin = 10
  187.                bx.Exi = 1
  188.                bx.Init1 = "Type initial search key for the customer"
  189.                bx.Init2 = "An exact match is not needed."
  190.                bx.KeyLen = 20
  191.  
  192.                IF Toggle% = 0 THEN
  193.                   bx.o1 = "F1 - Switch to first name search"
  194.                   Ix% = IxNum1%
  195.                ELSE
  196.                   bx.o1 = "F1 - Switch to last name search"
  197.                   Ix% = IxNum2%
  198.                END IF
  199.  
  200.                bx.Echoice = 0                         '  What's selected
  201.                bx.Btype = 1                           '  Border type
  202.                bx.Nf = 7
  203.                bx.Nb = 0
  204.                bx.Sf = 0
  205.                bx.Sb = 7
  206.                bx.Ff = 7
  207.                bx.Fb = 0
  208.  
  209.                KeySelectBox bx, Opt$, Ix%, Ky$, Mr%, Xnm$(), Xk$(), Xh%(), sc%
  210.  
  211.                IF bx.Echoice = -1 THEN                '  Index is Empty
  212.                   Delop$(1) = "No deleting available! There are no"
  213.                   Delop$(2) = "items in the database to delete!"
  214.                   Delop$(3) = ""
  215.                   Delop$(4) = "Press any key to continue"
  216.                   Message Delop$(), 4, 3, 7, 0, 7, 0
  217.                   EXIT DO
  218.                END IF
  219.  
  220.                IF Mr% > 0 AND sc% > 0 THEN
  221.  
  222.                   IF bx.Echoice = 1 THEN              '  Function key 1
  223.                      Toggle% = 1 - Toggle%
  224.                   ELSE                                '  Otherwise,
  225.                      IF Mr% THEN
  226.                         GET #DatFile%, Mr%, Cust      '  Get the details,
  227.                         GOSUB DisplayCust             '  display the details
  228.                         Delop$(1) = "YES, go ahead and delete " + Cust.FirstName
  229.                         Delop$(2) = "NO, I don't want to delete " + Cust.FirstName
  230.                                                       '  Setup Scroll Box
  231.                         NMw% = 0
  232.                         FOR j% = 1 TO 2
  233.                            Trim Delop$(j%)
  234.                            NMw% = Maximum%(LEN(Delop$(j%)), NMw%)
  235.                         NEXT j%
  236.  
  237.                         Irv% = 1
  238.                         ScrollBox Delop$(), NMw%, 2, 25, 1, 7, 7, 0, 7, 0, 1, 2, Ok%(), Irv%, rst$, GlbErr%
  239.                                                       '  Ask to Delete ?
  240.                         IF Irv% = 1 THEN              '  If 1, then YES
  241.                            TempFirst$ = Cust.FirstName'  Make copies of keys
  242.                            TempLast$ = Cust.LastName
  243.                            Mrec% = Mr%
  244.  
  245.                            Trim TempFirst$
  246.                            Trim TempLast$
  247.  
  248.                            IndexFind IxNum2%, TempFirst$, Mchk%, Xnm$(), Xk$(), Xh%(), sc%
  249.                            DO
  250.                               IF Mchk% = Mrec% THEN   '  YES! Found, so quit
  251.                                  EXIT DO
  252.                               ELSE                    '  Continue looking
  253.                                  IndexNext IxNum2%, TempFirst$, Mchk%, Xnm$(), Xk$(), Xh%(), sc%
  254.                               END IF
  255.                            LOOP                       '
  256.                                                       '  FOUND, Now Delete
  257.                            IndexKill IxNum2%, TempFirst$, Mchk%, Xnm$(), Xk$(), Xh%(), sc%
  258.  
  259.                            IndexFind IxNum1%, TempLast$, Mchk%, Xnm$(), Xk$(), Xh%(), sc%
  260.                            DO
  261.                               IF Mchk% = Mrec% THEN   '  YES! Found, so quit
  262.                                  EXIT DO
  263.                               ELSE                    '  Continue looking
  264.                                  IndexNext IxNum1%, TempLast$, Mchk%, Xnm$(), Xk$(), Xh%(), sc%
  265.                               END IF                  ' 
  266.                            LOOP
  267.                                                       '  DELETE It
  268.                            IndexKill IxNum1%, TempLast$, Mchk%, Xnm$(), Xk$(), Xh%(), sc%
  269.  
  270.                            GOSUB InitCust             '  Initialize Customer
  271.                            Cust.USED = "F"            '  Set flag to free
  272.  
  273.                            PUT #DatFile%, Mrec%, Cust '  Write blank Record
  274.  
  275.                         END IF                        '  Done
  276.  
  277.                      END IF
  278.                      EXIT DO
  279.                   END IF
  280.                ELSE
  281.                   EXIT DO
  282.                END IF
  283.             LOOP
  284.  
  285.  
  286.          CASE 4                                             '  Browse through customers
  287.  
  288.             Toggle% = 0
  289.             DO
  290.  
  291.                bx.Row = 5
  292.                bx.Col = 25
  293.                bx.Lin = 10
  294.                bx.Exi = 1
  295.                bx.Init1 = "Type initial search key for the customer"
  296.                bx.Init2 = "An exact match is not needed."
  297.                bx.KeyLen = 20
  298.  
  299.                IF Toggle% = 0 THEN
  300.                   bx.o1 = "F1 - Switch to first name search"
  301.                   Ix% = IxNum1%
  302.                ELSE
  303.                   bx.o1 = "F1 - Switch to last name search"
  304.                   Ix% = IxNum2%
  305.                END IF
  306.  
  307.                bx.Echoice = 0                               '  What's selected
  308.                bx.Btype = 1                                 '  Border type
  309.                bx.Nf = 7
  310.                bx.Nb = 0
  311.                bx.Sf = 0
  312.                bx.Sb = 7
  313.                bx.Ff = 7
  314.                bx.Fb = 0
  315.  
  316.                KeySelectBox bx, Opt$, Ix%, Ky$, Mr%, Xnm$(), Xk$(), Xh%(), sc%
  317.  
  318.                IF bx.Echoice = -1 THEN
  319.                   Delop$(1) = "No browsing available! There are no items"
  320.                   Delop$(2) = "in the database to browse through!"
  321.                   Delop$(3) = ""
  322.                   Delop$(4) = "Press any key to continue"
  323.                   Message Delop$(), 4, 3, 7, 0, 7, 0
  324.                   EXIT DO
  325.                END IF
  326.  
  327.  
  328.  
  329.                IF bx.Echoice = 11 THEN
  330.                   EXIT DO
  331.                END IF
  332.  
  333.                IF bx.Echoice = 1 THEN
  334.                   Toggle% = 1 - Toggle%
  335.                END IF
  336.  
  337.                WHILE bx.Echoice = 12
  338.                   GET #DatFile%, Mr%, Cust
  339.                   GOSUB DisplayCust
  340.                   Delop$(1) = "Next Customer"
  341.                   Delop$(2) = "Previous Customer"
  342.                   Delop$(3) = "Initiate new search"
  343.                   Delop$(4) = "QUIT"
  344.  
  345.                   NMw% = 0
  346.                   FOR j% = 1 TO 4
  347.                      Trim Delop$(j%)
  348.                      NMw% = Maximum%(LEN(Delop$(j%)), NMw%)
  349.                   NEXT j%
  350.  
  351.                   IF Toggle% = 1 THEN
  352.                      Ixv% = IxNum2%
  353.                      Att% = Attributes%(0, 7, 0, 0)
  354.                      ColorPrint "Browsing on first name", 22, 5, Att%
  355.                   ELSE
  356.                      Ixv% = IxNum1%
  357.                      Att% = Attributes%(0, 7, 0, 0)
  358.                      ColorPrint "Browsing on last name ", 22, 5, Att%
  359.                   END IF
  360.  
  361.  
  362.                   Irv% = 1
  363.                   ScrollBox Delop$(), NMw%, 4, 2, 1, 7, 7, 0, 7, 0, 1, 4, Ok%(), Irv%, rst$, GlbErr%
  364.  
  365.  
  366.                   IF Irv% = 3 THEN
  367.                      bx.Echoice = 0
  368.                   END IF
  369.  
  370.                   IF Irv% = 4 THEN
  371.                      EXIT DO
  372.                   END IF
  373.  
  374.                   IF Irv% = 1 THEN
  375.                      IndexNext Ixv%, TempFirst$, Mr%, Xnm$(), Xk$(), Xh%(), sc%
  376.                   ELSE
  377.                      IndexPrevious Ixv%, TempLast$, Mr%, Xnm$(), Xk$(), Xh%(), sc%
  378.                   END IF
  379.  
  380.                WEND
  381.  
  382.             LOOP
  383.  
  384.          CASE 5                                             ' QUIT
  385.             IndexClose IxNum1%, Xnm$(), Xk$(), Xh%()
  386.             IndexClose IxNum2%, Xnm$(), Xk$(), Xh%()
  387.             EXIT DO
  388.  
  389.          CASE 6
  390.             CLOSE
  391.             KILL f1$
  392.             KILL f2$ + ".*"
  393.             KILL f3$ + ".*"
  394.             END
  395.  
  396.          CASE ELSE
  397.       END SELECT
  398.    LOOP
  399.  
  400.    LOCATE 23, 1
  401.    END                                             '  End of program
  402.  
  403.  
  404. DisplayCust:                                       '  Display details on screen
  405.  
  406.    Att% = Attributes%(7, 0, 0, 0)
  407.  
  408.    ColorPrint Cust.LastName, 6, 23, Att%
  409.    ColorPrint Cust.FirstName, 7, 23, Att%
  410.    ColorPrint Cust.Title, 8, 23, Att%
  411.    ColorPrint Cust.Telephone, 9, 23, Att%
  412.    ColorPrint Cust.Address1, 10, 23, Att%
  413.    ColorPrint Cust.Address2, 11, 23, Att%
  414.    ColorPrint Cust.City, 12, 23, Att%
  415.    ColorPrint Cust.State, 13, 23, Att%
  416.    ColorPrint Cust.ZipCode, 14, 23, Att%
  417.    ColorPrint Cust.Country, 15, 23, Att%
  418.    ColorPrint Cust.Product, 17, 23, Att%
  419.    ColorPrint Cust.Version, 18, 23, Att%
  420.    ColorPrint Cust.DatePurch, 19, 23, Att%
  421.    ColorPrint Cust.Dealer, 20, 23, Att%
  422.  
  423.    FOR j% = 1 TO 15
  424.       Txt$ = MID$(Cust.Comments, (j% - 1) * 21 + 1, 21)
  425.       ColorPrint Txt$, 5 + j%, 58, Att%
  426.    NEXT j%
  427.  
  428.    RETURN
  429.  
  430. InitCust:                                          '  Set to blanks
  431.    Cust.LastName = ""
  432.    Cust.FirstName = ""
  433.    Cust.Title = ""
  434.    Cust.Telephone = ""
  435.    Cust.Address1 = ""
  436.    Cust.Address2 = ""
  437.    Cust.City = ""
  438.    Cust.State = ""
  439.    Cust.ZipCode = ""
  440.    Cust.Country = ""
  441.    Cust.Product = ""
  442.    Cust.Version = ""
  443.    Cust.DatePurch = ""
  444.    Cust.Dealer = ""
  445.    Cust.Comments = ""
  446.    RETURN
  447.  
  448. CustDetails:                                       '  Get Details
  449.  
  450.    Op% = 1
  451.  
  452.    DO
  453.       SELECT CASE Op%
  454.          CASE 1
  455.             Txt$ = Cust.LastName
  456.             TextInput 0, 0, 1, 0, 1, 0, 1, 20, Txt$, 23, 6, 7, 0, 0, Ek%
  457.             Trim Txt$
  458.  
  459.             IF LEN(Txt$) = 0 OR Ek% = 7 THEN
  460.                Op% = 99                                     '  Abort
  461.             ELSE
  462.                Cust.LastName = Txt$
  463.                Op% = Op% + 1
  464.             END IF
  465.  
  466.          CASE 2
  467.             Txt$ = Cust.FirstName
  468.             TextInput 1, 0, 1, 0, 1, 0, 1, 20, Txt$, 23, 7, 7, 0, 0, Ek%
  469.             Cust.FirstName = Txt$
  470.             Trim Txt$
  471.  
  472.             IF LEN(Txt$) = 0 OR Ek% = 7 THEN
  473.                Op% = 99                                     '  Abort
  474.             ELSE
  475.                IF Ek% = 1 THEN
  476.                   Op% = Op% - 1
  477.                ELSE
  478.                   Op% = Op% + 1
  479.                END IF
  480.             END IF
  481.  
  482.             Att% = Attributes%(0, 7, 0, 0)
  483.             ColorPrint "Press PgDn when finished entering details", 22, 5, Att%
  484.  
  485.          CASE 3
  486.             Txt$ = Cust.Title
  487.             TextInput 1, 0, 1, 1, 1, 0, 0, 20, Txt$, 23, 8, 7, 0, 0, Ek%
  488.             Cust.Title = Txt$
  489.             Op% = DBValidate%(Ek%, Op%)                  '  Next Option Function
  490.  
  491.  
  492.          CASE 4
  493.             Txt$ = Cust.Telephone
  494.             TextInput 1, 0, 1, 1, 1, 0, 0, 20, Txt$, 23, 9, 7, 0, 0, Ek%
  495.             Cust.Telephone = Txt$
  496.             Op% = DBValidate%(Ek%, Op%)
  497.  
  498.  
  499.          CASE 5
  500.             Txt$ = Cust.Address1
  501.             TextInput 1, 0, 1, 1, 1, 0, 0, 30, Txt$, 23, 10, 7, 0, 0, Ek%
  502.             Cust.Address1 = Txt$
  503.             Op% = DBValidate%(Ek%, Op%)
  504.  
  505.          CASE 6
  506.             Txt$ = Cust.Address2
  507.             TextInput 1, 0, 1, 1, 1, 0, 0, 30, Txt$, 23, 11, 7, 0, 0, Ek%
  508.             Cust.Address2 = Txt$
  509.             Op% = DBValidate%(Ek%, Op%)
  510.  
  511.          CASE 7
  512.             Txt$ = Cust.City
  513.             TextInput 1, 0, 1, 1, 1, 0, 0, 20, Txt$, 23, 12, 7, 0, 0, Ek%
  514.             Cust.City = Txt$
  515.             Op% = DBValidate%(Ek%, Op%)
  516.  
  517.          CASE 8
  518.             Txt$ = Cust.State
  519.             TextInput 1, 0, 1, 1, 1, 0, 0, 20, Txt$, 23, 13, 7, 0, 0, Ek%
  520.             Cust.State = Txt$
  521.             Op% = DBValidate%(Ek%, Op%)
  522.  
  523.          CASE 9
  524.             Txt$ = Cust.ZipCode
  525.             TextInput 1, 0, 1, 1, 1, 0, 0, 20, Txt$, 23, 14, 7, 0, 0, Ek%
  526.             Cust.ZipCode = Txt$
  527.             Op% = DBValidate%(Ek%, Op%)
  528.  
  529.          CASE 10
  530.             Txt$ = Cust.Country
  531.             TextInput 1, 0, 1, 1, 1, 0, 0, 20, Txt$, 23, 15, 7, 0, 0, Ek%
  532.             Cust.Country = Txt$
  533.             Op% = DBValidate%(Ek%, Op%)
  534.  
  535.          CASE 11
  536.             Txt$ = Cust.Product
  537.             TextInput 1, 0, 1, 1, 1, 0, 0, 30, Txt$, 23, 17, 7, 0, 0, Ek%
  538.             Cust.Product = Txt$
  539.             Op% = DBValidate%(Ek%, Op%)
  540.  
  541.          CASE 12
  542.             Txt$ = Cust.Version
  543.             TextInput 1, 0, 1, 1, 1, 0, 0, 20, Txt$, 23, 18, 7, 0, 0, Ek%
  544.             Cust.Version = Txt$
  545.             Op% = DBValidate%(Ek%, Op%)
  546.  
  547.          CASE 13
  548.             Txt$ = Cust.DatePurch
  549.             TextInput 1, 0, 1, 1, 1, 0, 0, 8, Txt$, 23, 19, 7, 0, 0, Ek%
  550.             Cust.DatePurch = Txt$
  551.             Op% = DBValidate%(Ek%, Op%)
  552.  
  553.          CASE 14
  554.             Txt$ = Cust.Dealer
  555.             TextInput 1, 0, 1, 1, 1, 0, 0, 30, Txt$, 23, 20, 7, 0, 0, Ek%
  556.             Cust.Dealer = Txt$
  557.             Op% = DBValidate%(Ek%, Op%)
  558.  
  559.          CASE 15 TO 29
  560.             FOR j% = 1 TO 15
  561.                Cmnt$(j%) = MID$(Cust.Comments, (j% - 1) * 21 + 1, 21)
  562.             NEXT j%
  563.  
  564.             Txt$ = Cmnt$(Op% - 14)
  565.             TextInput 1, 0, 1, 1, 1, 0, 0, 21, Txt$, 58, Op% - 9, 7, 0, 0, Ek%
  566.             Cmnt$(Op% - 14) = Txt$
  567.  
  568.             FOR j% = 1 TO 15
  569.                MID$(Cust.Comments, (j% - 1) * 21 + 1, 21) = Cmnt$(j%)
  570.             NEXT j%
  571.             Op% = DBValidate%(Ek%, Op%)
  572.  
  573.          CASE 30                                            '  END REACHED
  574.  
  575.             SELECT CASE rv%                                 '  Now, do option
  576.                                                             '  based on INSERT
  577.                                                             '  or Change
  578.  
  579.                CASE 1                                       '  INSERT
  580.                   w& = LOF(DatFile%)
  581.                   FreeRec% = 0
  582.  
  583.                   IF w& THEN
  584.                      LastRec% = CINT(w& / LEN(Cust))
  585.                      FOR j% = 1 TO LastRec%
  586.                         GET #DatFile%, j%, TestCust
  587.                         IF TestCust.USED = "F" THEN
  588.                            FreeRec% = j%
  589.                            EXIT FOR
  590.                         END IF
  591.                      NEXT j%
  592.                      IF FreeRec% = 0 THEN
  593.                         FreeRec% = j%
  594.                      END IF
  595.                   ELSE
  596.                      FreeRec% = 1
  597.                   END IF
  598.  
  599.                   Ky$ = Cust.LastName
  600.                   IndexInsert IxNum1%, Ky$, FreeRec%, Xnm$(), Xk$(), Xh%(), sc%
  601.                   IF sc% = 0 THEN
  602.                      PRINT "Index Insertion failure, Last Name!"
  603.                      END
  604.                   END IF
  605.  
  606.                   Ky$ = Cust.FirstName
  607.                   IndexInsert IxNum2%, Ky$, FreeRec%, Xnm$(), Xk$(), Xh%(), sc%
  608.                   IF sc% = 0 THEN
  609.                      PRINT "Index Insertion failure, First Name!"
  610.                      END
  611.                   END IF
  612.  
  613.                   Cust.USED = "U"
  614.  
  615.                   PUT #DatFile%, FreeRec%, Cust
  616.                   EXIT DO                                   '  INSERTED!
  617.  
  618.  
  619.                CASE 2                                       '  Amend
  620.  
  621.                   TempMrec% = Mr%
  622.                   Mrec% = Mr%
  623.  
  624.                   Test1$ = Cust.FirstName                   '  Need copies of keys
  625.                   Trim Test1$
  626.                   Trim TempFirst$
  627.  
  628.                   Test2$ = Cust.LastName
  629.                   Trim Test2$
  630.                   Trim TempLast$
  631.                                                             '  If the Index Keys
  632.                                                             '  have been changed,
  633.                                                             '  then they need to be
  634.                                                             '  deleted, and the
  635.                                                             '  re-inserted. this
  636.                                                             '  is a painless task, as
  637.                                                             '  the index is ALWAYS
  638.                                                             '  current. It needs no
  639.                                                             '  re-builds or batch
  640.                                                             '  updates.
  641.  
  642.                   IF Test1$ <> TempFirst$ THEN              '  Change Keys
  643.  
  644.                      IndexFind IxNum2%, TempFirst$, Mchk%, Xnm$(), Xk$(), Xh%(), sc%
  645.                      DO
  646.                         IF Mchk% = Mrec% THEN
  647.                            EXIT DO
  648.                         ELSE
  649.                            IndexNext IxNum2%, TempFirst$, Mchk%, Xnm$(), Xk$(), Xh%(), sc%
  650.                         END IF
  651.                      LOOP
  652.                      IndexKill IxNum2%, TempFirst$, Mchk%, Xnm$(), Xk$(), Xh%(), sc%
  653.                      IndexInsert IxNum2%, Test1$, Mrec%, Xnm$(), Xk$(), Xh%(), sc%
  654.                   END IF
  655.  
  656.                   Mrec% = TempMrec%
  657.  
  658.                   IF Test2$ <> TempLast$ THEN               '  Change Keys
  659.  
  660.                      IndexFind IxNum1%, TempLast$, Mchk%, Xnm$(), Xk$(), Xh%(), sc%
  661.                      DO
  662.                         IF Mchk% = Mrec% THEN
  663.                            EXIT DO
  664.                         ELSE
  665.                            IndexNext IxNum1%, TempLast$, Mchk%, Xnm$(), Xk$(), Xh%(), sc%
  666.  
  667.                         END IF
  668.                      LOOP
  669.                      IndexKill IxNum1%, TempLast$, Mchk%, Xnm$(), Xk$(), Xh%(), sc%
  670.                      IndexInsert IxNum1%, Test2$, Mrec%, Xnm$(), Xk$(), Xh%(), sc%
  671.                   END IF
  672.  
  673.                   Mrec% = TempMrec%
  674.  
  675.                   PUT #DatFile%, Mrec%, Cust          '  Write away the new
  676.                                                       '  amended customer
  677.                   EXIT DO
  678.  
  679.                CASE ELSE
  680.  
  681.             END SELECT
  682.  
  683.          CASE 99
  684.             EXIT DO
  685.  
  686.          CASE ELSE
  687.  
  688.             BEEP
  689.             PRINT "Fatal Error!"
  690.             PRINT "This point in the program should never be reached."
  691.  
  692.             END
  693.       END SELECT
  694.    LOOP
  695.  
  696.    RETURN
  697.  
  698.    END
  699.  
  700.  
  701. ' *********************************************************************
  702. ' * sharwar1.bas formatted from sharware.bas with option(s): MS CL A60
  703. ' * January 23, 1988 at  6:13 pm.  Formatted by QBF (C)opyright 1988.
  704. ' * QBF is available from Inventories Unlimited, USA, (215) 922-2557.
  705. ' * Longest lines: 107(276), 100(411), 97(148), 96(298), 95(311).
  706. ' * Total lines = 760.  Maximum indentation depth = 11.
  707. ' *********************************************************************
  708.  
  709.    FUNCTION DBValidate% (a%, b%)
  710.  
  711.       SELECT CASE a%
  712.          CASE 1                     '  Up arrow pressed ?
  713.             DBValidate% = b% - 1    '  Decrease the count
  714.  
  715.          CASE 4                     '  Page Down pressed ?
  716.             DBValidate% = 30        '  Last Option
  717.  
  718.          CASE ELSE                  '  Any other choice
  719.             DBValidate% = b% + 1    '  Increase the count
  720.  
  721.       END SELECT
  722.  
  723.    END FUNCTION
  724.  
  725.